home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 7
/
Apprentice-Release7.iso
/
Source Code
/
Pascal
/
Applications
/
TCPExample
/
PNL Libraries
/
DNR.p
next >
Wrap
Text File
|
1996-10-10
|
8KB
|
307 lines
unit DNR;
interface
uses
Types, TCPTypes;
type
ResultProcPtr = UniversalProcPtr;
{ procedure ResultProc(hip:hostInfoPtr; userdata:Ptr); }
EnumResultProcPtr = UniversalProcPtr;
{ procedure EnumResultProc(cerp:cacheEntryRecordPtr; userdata:Ptr); }
function OpenResolver: OSErr;
procedure CloseResolver;
function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
procedure AddrToStr (addr: longint; var s: Str255);
function EnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
function HInfo (host: Str255; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
function MXInfo (host: Str255; var mxi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
implementation
uses
Resources, Errors, Memory, MixedMode, Files, Folders,
MyCallProc, MyCStrings, MyMemory;
const
kOPENRESOLVER = 1;
kCLOSERESOLVER = 2;
kSTRTOADDR = 3;
kADDRTOSTR = 4;
kENUMCACHE = 5;
kADDRTONAME = 6;
kHINFO = 7;
kMXINFO = 8;
var
code: Handle;
procedure GetSystemFolder (var vrn: integer; var dirID: longint);
begin
if FindFolder(kOnSystemDisk, kSystemFolderType, false, vrn, dirID) <> noErr then begin
vrn := 0;
dirID := 0;
end;
end;
procedure GetCPanelFolder (var vrn: integer; var dirID: longint);
begin
if FindFolder(kOnSystemDisk, kControlPanelFolderType, false, vrn, dirID) <> noErr then begin
vrn := 0;
dirID := 0;
end;
end;
{ SearchFolderForDNRP is called to search a folder for files that might }
{ contain the 'dnrp' resource }
function SearchFolderForDNRP (ftype, fcreator: OSType; vrn: integer; dirID: longint): Handle;
var
pb: HParamBlockRec;
filename: Str63;
refnum: integer;
i: integer;
hhhh: Handle;
err: OSErr;
begin
hhhh := nil;
i := 1;
repeat
pb.ioNamePtr := @filename;
pb.ioVRefNum := vrn;
pb.ioDirID := dirID;
pb.ioFDirIndex := i;
i := i + 1;
err := PBHGetFInfoSync(@pb);
if err = noErr then begin
if (pb.ioFlFndrInfo.fdType = ftype) & (pb.ioFlFndrInfo.fdCreator = fcreator) then begin
SetResLoad(false);
refnum := HOpenResFile(vrn, dirID, filename, fsRdPerm);
SetResLoad(true);
if refnum <> -1 then begin
hhhh := Get1IndResource('dnrp', 1);
if hhhh <> nil then begin
DetachResource(hhhh);
end;
CloseResFile(refnum);
end;
end;
end;
until (err <> noErr) or (hhhh <> nil);
SearchFolderForDNRP := hhhh;
end;
function SearchForDNRP: Handle;
var
hhhh: Handle;
vrn: integer;
dirID: longint;
begin
{ first search Control Panels for MacTCP 1.1 }
GetCPanelFolder(vrn, dirID);
hhhh := SearchFolderForDNRP('cdev', 'ztcp', vrn, dirID);
if hhhh = nil then begin
{ next search System Folder for MacTCP 1.0.x }
GetSystemFolder(vrn, dirID);
hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
end;
if hhhh = nil then begin
{ then search Control Panels for MacTCP 1.0.x }
GetCPanelFolder(vrn, dirID);
hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
end;
if hhhh = nil then begin
{ finally, look in any open resource file }
hhhh := Get1IndResource('dnrp', 1);
if hhhh <> nil then begin
DetachResource(hhhh);
end;
end;
SearchForDNRP := hhhh;
end;
function CallOpenResolver: OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC244ProcInfo);
CallOpenResolver := CallC244(nil, kOPENRESOLVER,proc);
DisposeRoutineDescriptor(proc);
end;
function OpenResolver: OSErr;
var
err: OSErr;
begin
code := SearchForDNRP;
if code = nil then begin
err := resNotFound;
end else begin
HLock(code);
err := CallOpenResolver;
if err <> noErr then begin
MDisposeHandle(code);
end;
end;
OpenResolver := err;
end;
function CallCloseResolver:OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC24ProcInfo);
CallCloseResolver := CallC24(kCLOSERESOLVER,proc);
DisposeRoutineDescriptor(proc);
end;
procedure CloseResolver;
var
junk:OSErr;
begin
if code <> nil then begin
junk:=CallCloseResolver;
MDisposeHandle(code);
end;
end;
function CallStrToAddr (cname: CStringPtr; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC244444ProcInfo);
CallStrToAddr := CallC244444(userdata,completion,@rtnStruct,cname,kSTRTOADDR,proc);
DisposeRoutineDescriptor(proc);
end;
function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
err: OSErr;
begin
if code = nil then begin
err := notOpenErr;
end else begin
P2C(@host);
err := CallStrToAddr(@host, rtnStruct, completion, userdata);
end;
StrToAddr := err;
end;
function CallAddrToStr(addr: longint; cstr: CStringPtr):OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC2444ProcInfo);
CallAddrToStr := CallC2444(cstr, addr, kADDRTOSTR, proc);
DisposeRoutineDescriptor(proc);
end;
procedure AddrToStr (addr: longint; var s: Str255);
var
junk:OSErr;
len: integer;
begin
if code <> nil then begin
junk := CallAddrToStr(addr, @s);
len := 0;
while (s[len] <> chr(0)) & (len < 255) do begin
len := len + 1;
end;
BlockMoveData(@s, @s[1], len);
s[0] := chr(len);
end;
end;
function CallEnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC2444ProcInfo);
CallEnumCache := CallC2444(userdata, completion, kENUMCACHE, proc);
DisposeRoutineDescriptor(proc);
end;
function EnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
var
err: OSErr;
begin
if code = nil then begin
err := notOpenErr;
end else begin
err := CallEnumCache(completion, userdata);
end;
EnumCache := err;
end;
function CallAddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC244444ProcInfo);
CallAddrToName := CallC244444(userdata, completion, @hi, addr, kADDRTONAME, proc);
DisposeRoutineDescriptor(proc);
end;
function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
err: OSErr;
begin
if code = nil then begin
err := notOpenErr;
end else begin
err := CallAddrToName(addr, hi, completion, userdata);
end;
AddrToName := err;
end;
function CallHInfo (name: CStringPtr; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC244444ProcInfo);
CallHInfo := CallC244444(userdata, completion, @hi, name, kHINFO, proc);
DisposeRoutineDescriptor(proc);
end;
function HInfo (host: Str255; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
err: OSErr;
begin
if code = nil then begin
err := notOpenErr;
end else begin
P2C(@host);
err := CallHInfo(@host, hi, completion, userdata);
end;
HInfo := err;
end;
function CallMXInfo (name: CStringPtr; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
proc:UniversalProcPtr;
begin
proc:=New68kProc(code^,uppC244444ProcInfo);
CallMXInfo := CallC244444(userdata, completion, @hi, name, kMXINFO, proc);
DisposeRoutineDescriptor(proc);
end;
function MXInfo (host: Str255; var mxi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
var
err: OSErr;
begin
if code = nil then begin
err := notOpenErr;
end else begin
P2C(@host);
err := CallMXInfo(@host, mxi, completion, userdata);
end;
MXInfo := err;
end;
end.